home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / withfile < prev    next >
Text File  |  1993-02-28  |  3KB  |  84 lines
  1. ; "withfile.scm", with-input-from-file and with-output-to-file
  2. ; functions for Scheme.  
  3. ; Copyright (c) 1992, 1993 Aubrey Jaffer
  4.  
  5. ;Permission to copy this software, to redistribute it, and to use it
  6. ;for any purpose is granted, subject to the following restrictions and
  7. ;understandings.
  8.  
  9. ;1.  Any copy made of this software must include this copyright notice
  10. ;in full.
  11.  
  12. ;2.  I have made no warrantee or representation that the operation of
  13. ;this software will be error-free, and I am under no obligation to
  14. ;provide any services, by way of maintenance, update, or otherwise.
  15.  
  16. ;3.  In conjunction with products arising from the use of this
  17. ;material, there shall be no use of my name in any advertising,
  18. ;promotional, or sales literature without prior written consent in
  19. ;each case.
  20.  
  21. (require 'dynamic-wind)
  22.  
  23. (define withfile:current-input (current-input-port))
  24. (define withfile:current-output (current-output-port))
  25.  
  26. (define (current-input-port) withfile:current-input)
  27. (define (current-output-port) withfile:current-output)
  28.  
  29. (define (with-input-from-file file thunk)
  30.   (define oport withfile:current-input)
  31.   (define port (open-input-file file))
  32.   (dynamic-wind (lambda () (set! oport withfile:current-input)
  33.                (set! withfile:current-input port))
  34.         (lambda() (let ((ans (thunk))) (close-input-port port) ans))
  35.         (lambda() (set! withfile:current-input oport))))
  36.  
  37. (define (with-output-from-file file thunk)
  38.   (define oport withfile:current-output)
  39.   (define port (open-output-file file))
  40.   (dynamic-wind (lambda() (set! oport withfile:current-output)
  41.                   (set! withfile:current-output port))
  42.         (lambda() (let ((ans (thunk))) (close-output-port port) ans))
  43.         (lambda() (set! withfile:current-output oport))))
  44.  
  45. (define peek-char
  46.   (let ((peek-char peek-char))
  47.     (lambda opt
  48.       (peek-char (if (null? opt) withfile:current-input (car opt))))))
  49.  
  50. (define read-char
  51.   (let ((read-char read-char))
  52.     (lambda opt
  53.       (read-char (if (null? opt) withfile:current-input (car opt))))))
  54.  
  55. (define read
  56.   (let ((read read))
  57.     (lambda opt
  58.       (read (if (null? opt) withfile:current-input (car opt))))))
  59.  
  60. (define write-char
  61.   (let ((write-char write-char))
  62.     (lambda (obj . opt)
  63.       (write-char obj (if (null? opt) withfile:current-output (car opt))))))
  64.  
  65. (define write
  66.   (let ((write write))
  67.     (lambda (obj . opt)
  68.       (write obj (if (null? opt) withfile:current-output (car opt))))))
  69.  
  70. (define display
  71.   (let ((display display))
  72.     (lambda (obj . opt)
  73.       (display obj (if (null? opt) withfile:current-output (car opt))))))
  74.  
  75. (define newline
  76.   (let ((newline newline))
  77.     (lambda opt
  78.       (newline (if (null? opt) withfile:current-output (car opt))))))
  79.  
  80. (define force-output
  81.   (let ((force-output force-output))
  82.     (lambda opt
  83.       (force-output (if (null? opt) withfile:current-output (car opt))))))
  84.